home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / sftgrd / win.bas < prev   
Encoding:
BASIC Source File  |  1995-01-08  |  8.9 KB  |  294 lines
  1. ': WIN.BAS
  2. '-    Misc routines for working with Windows
  3. '
  4. ' Copyright 1994, AA-Software International
  5. '     Distributed for non-commercial educational use only.
  6. '     For other use contact:
  7. '        AA-Software International
  8. '        12 ter Domaine Du Bois Joli
  9. '        06330 Roquefort-Les-Pins, France
  10. '
  11. '        Tel: (+33) 93.77.50.47
  12. '        Fax: (+33) 93.77.19.78
  13. '        Internet: cswilly@acm.org
  14. '        CompuServe: 100343,2570
  15. '
  16. Option Explicit
  17.  
  18. Dim windowsList_h()        As Integer
  19. Dim windowsTitles_s()      As String
  20. Dim instanceOwnerList_h()  As Integer
  21.  
  22. Const GW_CHILD = 5
  23. Const GW_HWNDNEXT = 2
  24. Declare Function GetDeskTopWindow% Lib "User" ()
  25. Declare Function GetWindow% Lib "User" (ByVal hWnd%, ByVal wCmd%)
  26. Declare Function GetWindowTextLength% Lib "User" (ByVal hWnd%)
  27. Declare Function GetWindowText% Lib "User" (ByVal hWnd%, ByVal lpString$, ByVal strLen%)
  28. Declare Function GetWindowWord% Lib "User" (ByVal hWnd%, ByVal nIndex%)
  29.  
  30. Declare Function LoadIcon Lib "User" (ByVal hInstance As Integer, ByVal lpIconName As Any) As Integer
  31. Declare Function DrawIcon Lib "User" (ByVal hDC As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal hIcon As Integer) As Integer
  32.  
  33.  
  34. Declare Function SendMessage Lib "user.exe" (ByVal h As Integer, ByVal m As Integer, ByVal w As Integer, l As Any) As Long
  35.  
  36. Declare Function getFocus Lib "user.exe" () As Integer
  37. Declare Function SetFocusAPI% Lib "User" Alias "SetFocus" (ByVal hWnd%)
  38. Declare Function ShowWindow% Lib "User" (ByVal hWnd%, ByVal nCmdShow%)
  39. Declare Function IsWindow% Lib "User" (ByVal hWnd%)
  40. Declare Function IsWindowVisible% Lib "User" (ByVal hWnd%)
  41. Declare Function IsIconic% Lib "User" (ByVal hWnd%)
  42.  
  43.  
  44. Const SWP_NOMOVE = 2
  45. Const SWP_NOSIZE = 1
  46. Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  47. Const HWND_TOPMOST = -1
  48. Const HWND_NOTOPMOST = -2
  49. Declare Function SetWindowPos Lib "user" (ByVal h%, ByVal hb%, ByVal x%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal f%) As Integer
  50.  
  51. Global Const WM_USER = &H400
  52. ''  Listbox messages
  53. Global Const LB_ADDSTRING = (WM_USER + 1)
  54. Global Const LB_INSERTSTRING = (WM_USER + 2)
  55. Global Const LB_DELETESTRING = (WM_USER + 3)
  56. Global Const LB_RESETCONTENT = (WM_USER + 5)
  57. Global Const LB_SETSEL = (WM_USER + 6)
  58. Global Const LB_SETCURSEL = (WM_USER + 7)
  59. Global Const LB_GETSEL = (WM_USER + 8)
  60. Global Const LB_GETCURSEL = (WM_USER + 9)
  61. Global Const LB_GETTEXT = (WM_USER + 10)
  62. Global Const LB_GETTEXTLEN = (WM_USER + 11)
  63. Global Const LB_GETCOUNT = (WM_USER + 12)
  64. Global Const LB_SELECTSTRING = (WM_USER + 13)
  65. Global Const LB_DIR = (WM_USER + 14)
  66. Global Const LB_GETTOPINDEX = (WM_USER + 15)
  67. Global Const LB_FINDSTRING = (WM_USER + 16)
  68. Global Const LB_GETSELCOUNT = (WM_USER + 17)
  69. Global Const LB_GETSELITEMS = (WM_USER + 18)
  70. Global Const LB_SETTABSTOPS = (WM_USER + 19)
  71. Global Const LB_GETHORIZONTALEXTENT = (WM_USER + 20)
  72. Global Const LB_SETHORIZONTALEXTENT = (WM_USER + 21)
  73. Global Const LB_SETCOLUMNWIDTH = (WM_USER + 22)
  74. Global Const LB_SETTOPINDEX = (WM_USER + 24)
  75. Global Const LB_GETITEMRECT = (WM_USER + 25)
  76. Global Const LB_GETITEMDATA = (WM_USER + 26)
  77. Global Const LB_SETITEMDATA = (WM_USER + 27)
  78. Global Const LB_SELITEMRANGE = (WM_USER + 28)
  79. Global Const LB_MSGMAX = (WM_USER + 33)
  80. Global Const LB_SETCARETINDEX = (WM_USER + 31)
  81. Global Const LB_GETCARETINDEX = (WM_USER + 32)
  82. Global Const LB_SETITEMHEIGHT = (WM_USER + 33)
  83. Global Const LB_GETITEMHEIGHT = (WM_USER + 34)
  84. Global Const LB_FINDSTRINGEXACT = (WM_USER + 35)
  85.  
  86. Private Sub pGetIcon (picControl As Control, ByVal win_h As Integer)
  87.       
  88.       'Clear previous ICON
  89.       picControl.Picture = LoadPicture("")
  90.  
  91.       Const GWW_HINSTANCE = (-6)
  92.       Dim hInstance As Integer
  93.       hInstance = GetWindowWord%(win_h, GWW_HINSTANCE)
  94.       
  95.       ' Iterate through icon resource identifier values
  96.       '  until you obtain a valid handle to an icon.
  97.       Dim hIcon As Integer
  98.       Dim n&
  99.       Do
  100.          hIcon = LoadIcon(hInstance, n&)
  101.          n& = n& + 1
  102.       Loop Until hIcon <> 0 Or n& > 10000
  103.       
  104.       If n& <= 10000 Then
  105.       Dim r As Integer
  106.       picControl.AutoRedraw = -1 ' Make hDC point to persistent bitmap.
  107.       Rem r = DrawIcon(picControl.hDC, 19, 19, hIcon) 'Draw the icon.
  108.       r = DrawIcon(picControl.hDC, 1, 1, hIcon) 'Draw the icon.
  109.       picControl.Refresh         ' Refresh from persistent bitmap to Picture.
  110.       End If
  111.  
  112. End Sub
  113.  
  114. Sub win_DisplayWindowsTasks (ctlDisplayOutput As Control)
  115.    
  116.    ctlDisplayOutput.Clear
  117.  
  118.    'Get to top level window
  119.    Dim wnd_h As Integer
  120.    wnd_h = GetDeskTopWindow%()
  121.  
  122.    'Get first child
  123.    wnd_h = GetWindow%(wnd_h, GW_CHILD)
  124.    
  125.    Dim listLen_i As Integer
  126.    listLen_i = 0
  127.    
  128.    Do While wnd_h <> 0
  129.  
  130.       'Get the Windows Title
  131.       Dim textLength_i As Integer
  132.       textLength_i = GetWindowTextLength%(wnd_h) + 1
  133.       Dim windowText_s As String
  134.       windowText_s = Space(textLength_i)
  135.       textLength_i = GetWindowText%(wnd_h, windowText_s, textLength_i)
  136.       
  137.       'Filter out duplicate windows
  138.       'Get the owner of the window
  139.       Const GWW_HINSTANCE = (-6)
  140.       Dim instanceOwner_h As Integer
  141.       instanceOwner_h = GetWindowWord%(wnd_h, GWW_HINSTANCE)
  142.       'Lookup instance
  143.       Dim i As Integer
  144.       For i = 0 To listLen_i - 1
  145.          If instanceOwner_h = instanceOwnerList_h(i) Then
  146.             instanceOwner_h = 0
  147.             Exit For
  148.          End If
  149.       Next i
  150.  
  151.       'Ensure Title is not null and no duplicate instances
  152.       If textLength_i <> 0 And IsWindowVisible%(wnd_h) And instanceOwner_h <> 0 Then
  153.  
  154.  
  155.  
  156.          'Add window to list
  157.          ReDim Preserve windowsList_h(listLen_i)
  158.          windowsList_h(listLen_i) = wnd_h
  159.          ReDim Preserve windowsTitles_s(listLen_i)
  160.          windowsTitles_s(listLen_i) = Left$(windowText_s, textLength_i)
  161.          ReDim Preserve instanceOwnerList_h(listLen_i)
  162.          instanceOwnerList_h(listLen_i) = instanceOwner_h
  163.  
  164.          'Display window's title
  165.          ctlDisplayOutput.AddItem windowsTitles_s(listLen_i)
  166.  
  167.          listLen_i = listLen_i + 1
  168.       End If
  169.       
  170.       'Get next child
  171.       wnd_h = GetWindow%(wnd_h, GW_HWNDNEXT)
  172.    Loop
  173.  
  174. End Sub
  175.  
  176. Sub win_GetIcon (picControl As Control, ByVal winTitle_s As String)
  177.    'find windows handel index
  178.    Dim winIndex_i As Integer
  179.    For winIndex_i = 0 To UBound(windowsTitles_s)
  180.       If winTitle_s = windowsTitles_s(winIndex_i) Then Exit For
  181.    Next winIndex_i
  182.  
  183.    'get the handel
  184.    Dim wnd_h As Integer
  185.    wnd_h = windowsList_h(winIndex_i)
  186.  
  187.    'Verify the handel is still good
  188.    If IsWindow%(wnd_h) Then
  189.       pGetIcon picControl, wnd_h
  190.    End If
  191.  
  192. End Sub
  193.  
  194. Sub win_ListBoxAddTabItem5 (l As Control, i1 As String, i2 As String, i3 As String, i4 As String, i5 As String, i6 As String)
  195.  
  196.  
  197.    Dim item_s As String
  198.  
  199.    item_s = i1
  200.  
  201.    If i2 <> "" Then item_s = item_s & Chr$(9) & i2
  202.    If i3 <> "" Then item_s = item_s & Chr$(9) & i3
  203.    If i4 <> "" Then item_s = item_s & Chr$(9) & i4
  204.    If i5 <> "" Then item_s = item_s & Chr$(9) & i5
  205.    If i6 <> "" Then item_s = item_s & Chr$(9) & i6
  206.  
  207.    l.AddItem item_s
  208.  
  209. End Sub
  210.  
  211. Sub win_ListBoxAddTabItems (l As Control, items_s() As String)
  212.  
  213.    Dim item_s As String
  214.    item_s = items_s(0)
  215.  
  216.  
  217.    Dim i As Integer
  218.    For i = 1 To UBound(items_s)
  219.       item_s = item_s & Chr$(9) & items_s(i)
  220.       Next i
  221.  
  222.    l.AddItem item_s
  223.  
  224. End Sub
  225.  
  226. Sub win_ListBoxSetTabs (c As Control, tabValues() As Integer)
  227.  
  228.    Dim i As Integer
  229.    For i = 0 To UBound(tabValues)
  230.       tabValues(i) = tabValues(i) * 4
  231.       If tabValues(i) = 0 Then Exit For
  232.    Next i
  233.    
  234.    Dim retval As Long
  235.    retval = SendMessage(c.hWnd, LB_SETTABSTOPS, i, tabValues(0))
  236.  
  237. End Sub
  238.  
  239. Sub win_ListBoxSetTabs5 (c As Control, t1 As Integer, t2 As Integer, t3 As Integer, t4 As Integer, t5 As Integer)
  240.  
  241.    ReDim tabValues(4) As Integer
  242.    tabValues(0) = t1
  243.    tabValues(1) = t2
  244.    tabValues(2) = t3
  245.    tabValues(3) = t4
  246.    tabValues(4) = t5
  247.  
  248.    win_ListBoxSetTabs c, tabValues()
  249.  
  250. End Sub
  251.  
  252. Sub win_SetFocus (ByVal winTitle_s As String)
  253.  
  254.    'find windows handel index
  255.    Dim winIndex_i As Integer
  256.    For winIndex_i = 0 To UBound(windowsTitles_s)
  257.       If winTitle_s = windowsTitles_s(winIndex_i) Then Exit For
  258.    Next winIndex_i
  259.  
  260.    
  261.    'get the handel
  262.    Dim wnd_h As Integer
  263.    wnd_h = windowsList_h(winIndex_i)
  264.  
  265.    'Verify the handel is still good
  266.    If IsWindow%(wnd_h) Then
  267.       'Set focus to selected window
  268.       Dim previousWnd_h As Integer
  269.  
  270.       previousWnd_h = ShowWindow%(wnd_h, 9)
  271.       previousWnd_h = SetFocusAPI%(wnd_h)
  272.    End If
  273.  
  274. End Sub
  275.  
  276. Sub win_SetWindowNotTopMost (ByVal win_h As Integer)
  277.  
  278.    Dim retval_i As Integer
  279.    retval_i = SetWindowPos(win_h, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
  280.  
  281. 'Note:
  282. '  retval_i is not check, but is non-zero if the set was successfull
  283. End Sub
  284.  
  285. Sub win_SetWindowTopMost (ByVal win_h As Integer)
  286.  
  287.    Dim retval_i As Integer
  288.    retval_i = SetWindowPos(win_h, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  289.  
  290. 'Note:
  291. '  retval_i is not check, but is non-zero if the set was successfull
  292. End Sub
  293.  
  294.